home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / ExtUtils / MM_VMS.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  58.3 KB  |  1,963 lines
  1. package ExtUtils::MM_VMS;
  2.  
  3. use strict;
  4.  
  5. use ExtUtils::MakeMaker::Config;
  6. require Exporter;
  7.  
  8. BEGIN {
  9.     # so we can compile the thing on non-VMS platforms.
  10.     if( $^O eq 'VMS' ) {
  11.         require VMS::Filespec;
  12.         VMS::Filespec->import;
  13.     }
  14. }
  15.  
  16. use File::Basename;
  17.  
  18. # $Revision can't be on the same line or SVN/K gets confused
  19. use vars qw($Revision
  20.             $VERSION @ISA);
  21. $VERSION = '6.42';
  22.  
  23. require ExtUtils::MM_Any;
  24. require ExtUtils::MM_Unix;
  25. @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  26.  
  27. use ExtUtils::MakeMaker qw($Verbose neatvalue);
  28. $Revision = $ExtUtils::MakeMaker::Revision;
  29.  
  30.  
  31. =head1 NAME
  32.  
  33. ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
  34.  
  35. =head1 SYNOPSIS
  36.  
  37.   Do not use this directly.
  38.   Instead, use ExtUtils::MM and it will figure out which MM_*
  39.   class to use for you.
  40.  
  41. =head1 DESCRIPTION
  42.  
  43. See ExtUtils::MM_Unix for a documentation of the methods provided
  44. there. This package overrides the implementation of these methods, not
  45. the semantics.
  46.  
  47. =head2 Methods always loaded
  48.  
  49. =over 4
  50.  
  51. =item wraplist
  52.  
  53. Converts a list into a string wrapped at approximately 80 columns.
  54.  
  55. =cut
  56.  
  57. sub wraplist {
  58.     my($self) = shift;
  59.     my($line,$hlen) = ('',0);
  60.  
  61.     foreach my $word (@_) {
  62.       # Perl bug -- seems to occasionally insert extra elements when
  63.       # traversing array (scalar(@array) doesn't show them, but
  64.       # foreach(@array) does) (5.00307)
  65.       next unless $word =~ /\w/;
  66.       $line .= ' ' if length($line);
  67.       if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
  68.       $line .= $word;
  69.       $hlen += length($word) + 2;
  70.     }
  71.     $line;
  72. }
  73.  
  74.  
  75. # This isn't really an override.  It's just here because ExtUtils::MM_VMS
  76. # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext()
  77. # in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
  78. # mimic inheritance here and hand off to ExtUtils::Liblist::Kid.
  79. # XXX This hackery will die soon. --Schwern
  80. sub ext {
  81.     require ExtUtils::Liblist::Kid;
  82.     goto &ExtUtils::Liblist::Kid::ext;
  83. }
  84.  
  85. =back
  86.  
  87. =head2 Methods
  88.  
  89. Those methods which override default MM_Unix methods are marked
  90. "(override)", while methods unique to MM_VMS are marked "(specific)".
  91. For overridden methods, documentation is limited to an explanation
  92. of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
  93. documentation for more details.
  94.  
  95. =over 4
  96.  
  97. =item guess_name (override)
  98.  
  99. Try to determine name of extension being built.  We begin with the name
  100. of the current directory.  Since VMS filenames are case-insensitive,
  101. however, we look for a F<.pm> file whose name matches that of the current
  102. directory (presumably the 'main' F<.pm> file for this extension), and try
  103. to find a C<package> statement from which to obtain the Mixed::Case
  104. package name.
  105.  
  106. =cut
  107.  
  108. sub guess_name {
  109.     my($self) = @_;
  110.     my($defname,$defpm,@pm,%xs,$pm);
  111.     local *PM;
  112.  
  113.     $defname = basename(fileify($ENV{'DEFAULT'}));
  114.     $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
  115.     $defpm = $defname;
  116.     # Fallback in case for some reason a user has copied the files for an
  117.     # extension into a working directory whose name doesn't reflect the
  118.     # extension's name.  We'll use the name of a unique .pm file, or the
  119.     # first .pm file with a matching .xs file.
  120.     if (not -e "${defpm}.pm") {
  121.       @pm = map { s/.pm$//; $_ } glob('*.pm');
  122.       if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
  123.       elsif (@pm) {
  124.         %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
  125.         if (keys %xs) { 
  126.             foreach $pm (@pm) { 
  127.                 $defpm = $pm, last if exists $xs{$pm}; 
  128.             } 
  129.         }
  130.       }
  131.     }
  132.     if (open(PM,"${defpm}.pm")){
  133.         while (<PM>) {
  134.             if (/^\s*package\s+([^;]+)/i) {
  135.                 $defname = $1;
  136.                 last;
  137.             }
  138.         }
  139.         print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
  140.                      "defaulting package name to $defname\n"
  141.             if eof(PM);
  142.         close PM;
  143.     }
  144.     else {
  145.         print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
  146.                      "defaulting package name to $defname\n";
  147.     }
  148.     $defname =~ s#[\d.\-_]+$##;
  149.     $defname;
  150. }
  151.  
  152. =item find_perl (override)
  153.  
  154. Use VMS file specification syntax and CLI commands to find and
  155. invoke Perl images.
  156.  
  157. =cut
  158.  
  159. sub find_perl {
  160.     my($self, $ver, $names, $dirs, $trace) = @_;
  161.     my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
  162.     my($rslt);
  163.     my($inabs) = 0;
  164.     local *TCF;
  165.  
  166.     if( $self->{PERL_CORE} ) {
  167.         # Check in relative directories first, so we pick up the current
  168.         # version of Perl if we're running MakeMaker as part of the main build.
  169.         @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
  170.                         my($absb) = $self->file_name_is_absolute($b);
  171.                         if ($absa && $absb) { return $a cmp $b }
  172.                         else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
  173.                       } @$dirs;
  174.         # Check miniperl before perl, and check names likely to contain
  175.         # version numbers before "generic" names, so we pick up an
  176.         # executable that's less likely to be from an old installation.
  177.         @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
  178.                          my($bb) = $b =~ m!([^:>\]/]+)$!;
  179.                          my($ahasdir) = (length($a) - length($ba) > 0);
  180.                          my($bhasdir) = (length($b) - length($bb) > 0);
  181.                          if    ($ahasdir and not $bhasdir) { return 1; }
  182.                          elsif ($bhasdir and not $ahasdir) { return -1; }
  183.                          else { $bb =~ /\d/ <=> $ba =~ /\d/
  184.                                   or substr($ba,0,1) cmp substr($bb,0,1)
  185.                                   or length($bb) <=> length($ba) } } @$names;
  186.     }
  187.     else {
  188.         @sdirs  = @$dirs;
  189.         @snames = @$names;
  190.     }
  191.  
  192.     # Image names containing Perl version use '_' instead of '.' under VMS
  193.     foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
  194.     if ($trace >= 2){
  195.     print "Looking for perl $ver by these names:\n";
  196.     print "\t@snames,\n";
  197.     print "in these dirs:\n";
  198.     print "\t@sdirs\n";
  199.     }
  200.     foreach $dir (@sdirs){
  201.     next unless defined $dir; # $self->{PERL_SRC} may be undefined
  202.     $inabs++ if $self->file_name_is_absolute($dir);
  203.     if ($inabs == 1) {
  204.         # We've covered relative dirs; everything else is an absolute
  205.         # dir (probably an installed location).  First, we'll try potential
  206.         # command names, to see whether we can avoid a long MCR expression.
  207.         foreach $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; }
  208.         $inabs++; # Should happen above in next $dir, but just in case . . .
  209.     }
  210.     foreach $name (@snames){
  211.         if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
  212.         else                     { push(@cand,$self->fixpath($name,0));    }
  213.     }
  214.     }
  215.     foreach $name (@cand) {
  216.     print "Checking $name\n" if ($trace >= 2);
  217.     # If it looks like a potential command, try it without the MCR
  218.         if ($name =~ /^[\w\-\$]+$/) {
  219.             open(TCF,">temp_mmvms.com") || die('unable to open temp file');
  220.             print TCF "\$ set message/nofacil/nosever/noident/notext\n";
  221.             print TCF "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n";
  222.             close TCF;
  223.             $rslt = `\@temp_mmvms.com` ;
  224.             unlink('temp_mmvms.com');
  225.             if ($rslt =~ /VER_OK/) {
  226.                 print "Using PERL=$name\n" if $trace;
  227.                 return $name;
  228.             }
  229.         }
  230.     next unless $vmsfile = $self->maybe_command($name);
  231.     $vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
  232.     print "Executing $vmsfile\n" if ($trace >= 2);
  233.         open(TCF,">temp_mmvms.com") || die('unable to open temp file');
  234.         print TCF "\$ set message/nofacil/nosever/noident/notext\n";
  235.         print TCF "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n";
  236.         close TCF;
  237.         $rslt = `\@temp_mmvms.com`;
  238.         unlink('temp_mmvms.com');
  239.         if ($rslt =~ /VER_OK/) {
  240.         print "Using PERL=MCR $vmsfile\n" if $trace;
  241.         return "MCR $vmsfile";
  242.     }
  243.     }
  244.     print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
  245.     0; # false and not empty
  246. }
  247.  
  248. =item maybe_command (override)
  249.  
  250. Follows VMS naming conventions for executable files.
  251. If the name passed in doesn't exactly match an executable file,
  252. appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
  253. to check for DCL procedure.  If this fails, checks directories in DCL$PATH
  254. and finally F<Sys$System:> for an executable file having the name specified,
  255. with or without the F<.Exe>-equivalent suffix.
  256.  
  257. =cut
  258.  
  259. sub maybe_command {
  260.     my($self,$file) = @_;
  261.     return $file if -x $file && ! -d _;
  262.     my(@dirs) = ('');
  263.     my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
  264.     my($dir,$ext);
  265.     if ($file !~ m![/:>\]]!) {
  266.     for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
  267.         $dir = $ENV{"DCL\$PATH;$i"};
  268.         $dir .= ':' unless $dir =~ m%[\]:]$%;
  269.         push(@dirs,$dir);
  270.     }
  271.     push(@dirs,'Sys$System:');
  272.     foreach $dir (@dirs) {
  273.         my $sysfile = "$dir$file";
  274.         foreach $ext (@exts) {
  275.         return $file if -x "$sysfile$ext" && ! -d _;
  276.         }
  277.     }
  278.     }
  279.     return 0;
  280. }
  281.  
  282.  
  283. =item pasthru (override)
  284.  
  285. VMS has $(MMSQUALIFIERS) which is a listing of all the original command line
  286. options.  This is used in every invocation of make in the VMS Makefile so
  287. PASTHRU should not be necessary.  Using PASTHRU tends to blow commands past
  288. the 256 character limit.
  289.  
  290. =cut
  291.  
  292. sub pasthru {
  293.     return "PASTHRU=\n";
  294. }
  295.  
  296.  
  297. =item pm_to_blib (override)
  298.  
  299. VMS wants a dot in every file so we can't have one called 'pm_to_blib',
  300. it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when
  301. you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'.
  302.  
  303. So in VMS its pm_to_blib.ts.
  304.  
  305. =cut
  306.  
  307. sub pm_to_blib {
  308.     my $self = shift;
  309.  
  310.     my $make = $self->SUPER::pm_to_blib;
  311.  
  312.     $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m;
  313.     $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts};
  314.  
  315.     $make = <<'MAKE' . $make;
  316. # Dummy target to match Unix target name; we use pm_to_blib.ts as
  317. # timestamp file to avoid repeated invocations under VMS
  318. pm_to_blib : pm_to_blib.ts
  319.     $(NOECHO) $(NOOP)
  320.  
  321. MAKE
  322.  
  323.     return $make;
  324. }
  325.  
  326.  
  327. =item perl_script (override)
  328.  
  329. If name passed in doesn't specify a readable file, appends F<.com> or
  330. F<.pl> and tries again, since it's customary to have file types on all files
  331. under VMS.
  332.  
  333. =cut
  334.  
  335. sub perl_script {
  336.     my($self,$file) = @_;
  337.     return $file if -r $file && ! -d _;
  338.     return "$file.com" if -r "$file.com";
  339.     return "$file.pl" if -r "$file.pl";
  340.     return '';
  341. }
  342.  
  343.  
  344. =item replace_manpage_separator
  345.  
  346. Use as separator a character which is legal in a VMS-syntax file name.
  347.  
  348. =cut
  349.  
  350. sub replace_manpage_separator {
  351.     my($self,$man) = @_;
  352.     $man = unixify($man);
  353.     $man =~ s#/+#__#g;
  354.     $man;
  355. }
  356.  
  357. =item init_DEST
  358.  
  359. (override) Because of the difficulty concatenating VMS filepaths we
  360. must pre-expand the DEST* variables.
  361.  
  362. =cut
  363.  
  364. sub init_DEST {
  365.     my $self = shift;
  366.  
  367.     $self->SUPER::init_DEST;
  368.  
  369.     # Expand DEST variables.
  370.     foreach my $var ($self->installvars) {
  371.         my $destvar = 'DESTINSTALL'.$var;
  372.         $self->{$destvar} = File::Spec->eliminate_macros($self->{$destvar});
  373.     }
  374. }
  375.  
  376.  
  377. =item init_DIRFILESEP
  378.  
  379. No seperator between a directory path and a filename on VMS.
  380.  
  381. =cut
  382.  
  383. sub init_DIRFILESEP {
  384.     my($self) = shift;
  385.  
  386.     $self->{DIRFILESEP} = '';
  387.     return 1;
  388. }
  389.  
  390.  
  391. =item init_main (override)
  392.  
  393.  
  394. =cut
  395.  
  396. sub init_main {
  397.     my($self) = shift;
  398.  
  399.     $self->SUPER::init_main;
  400.  
  401.     $self->{DEFINE} ||= '';
  402.     if ($self->{DEFINE} ne '') {
  403.         my(@terms) = split(/\s+/,$self->{DEFINE});
  404.         my(@defs,@udefs);
  405.         foreach my $def (@terms) {
  406.             next unless $def;
  407.             my $targ = \@defs;
  408.             if ($def =~ s/^-([DU])//) {    # If it was a Unix-style definition
  409.                 $targ = \@udefs if $1 eq 'U';
  410.                 $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
  411.                 $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
  412.             }
  413.             if ($def =~ /=/) {
  414.                 $def =~ s/"/""/g;  # Protect existing " from DCL
  415.                 $def = qq["$def"]; # and quote to prevent parsing of =
  416.             }
  417.             push @$targ, $def;
  418.         }
  419.  
  420.         $self->{DEFINE} = '';
  421.         if (@defs)  { 
  422.             $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')'; 
  423.         }
  424.         if (@udefs) { 
  425.             $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')'; 
  426.         }
  427.     }
  428. }
  429.  
  430. =item init_others (override)
  431.  
  432. Provide VMS-specific forms of various utility commands, then hand
  433. off to the default MM_Unix method.
  434.  
  435. DEV_NULL should probably be overriden with something.
  436.  
  437. Also changes EQUALIZE_TIMESTAMP to set revision date of target file to
  438. one second later than source file, since MMK interprets precisely
  439. equal revision dates for a source and target file as a sign that the
  440. target needs to be updated.
  441.  
  442. =cut
  443.  
  444. sub init_others {
  445.     my($self) = @_;
  446.  
  447.     $self->{NOOP}               = 'Continue';
  448.     $self->{NOECHO}             ||= '@ ';
  449.  
  450.     $self->{MAKEFILE}        ||= $self->{FIRST_MAKEFILE} || 'Descrip.MMS';
  451.     $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE};
  452.     $self->{MAKE_APERL_FILE}    ||= 'Makeaperl.MMS';
  453.     $self->{MAKEFILE_OLD}       ||= $self->eliminate_macros('$(FIRST_MAKEFILE)_old');
  454. #
  455. #   If an extension is not specified, then MMS/MMK assumes an
  456. #   an extension of .MMS.  If there really is no extension,
  457. #   then a trailing "." needs to be appended to specify a
  458. #   a null extension.
  459. #
  460.     $self->{MAKEFILE} .= '.' unless $self->{MAKEFILE} =~ m/\./;
  461.     $self->{FIRST_MAKEFILE} .= '.' unless $self->{FIRST_MAKEFILE} =~ m/\./;
  462.     $self->{MAKE_APERL_FILE} .= '.' unless $self->{MAKE_APERL_FILE} =~ m/\./;
  463.     $self->{MAKEFILE_OLD} .= '.' unless $self->{MAKEFILE_OLD} =~ m/\./;
  464.  
  465.     $self->{MACROSTART}         ||= '/Macro=(';
  466.     $self->{MACROEND}           ||= ')';
  467.     $self->{USEMAKEFILE}        ||= '/Descrip=';
  468.  
  469.     $self->{ECHO}     ||= '$(ABSPERLRUN) -le "print qq{@ARGV}"';
  470.     $self->{ECHO_N}   ||= '$(ABSPERLRUN) -e  "print qq{@ARGV}"';
  471.     $self->{TOUCH}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e touch';
  472.     $self->{CHMOD}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e chmod'; 
  473.     $self->{RM_F}     ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_f';
  474.     $self->{RM_RF}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_rf';
  475.     $self->{TEST_F}   ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e test_f';
  476.     $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"';
  477.  
  478.     $self->{MOD_INSTALL} ||= 
  479.       $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
  480. install({split(' ',<STDIN>)}, '$(VERBINST)', 0, '$(UNINST)');
  481. CODE
  482.  
  483.     $self->{SHELL}    ||= 'Posix';
  484.  
  485.     $self->SUPER::init_others;
  486.  
  487.     # So we can copy files into directories with less fuss
  488.     $self->{CP}         = '$(ABSPERLRUN) "-MExtUtils::Command" -e cp';
  489.     $self->{MV}         = '$(ABSPERLRUN) "-MExtUtils::Command" -e mv';
  490.  
  491.     $self->{UMASK_NULL} = '! ';  
  492.  
  493.     # Redirection on VMS goes before the command, not after as on Unix.
  494.     # $(DEV_NULL) is used once and its not worth going nuts over making
  495.     # it work.  However, Unix's DEV_NULL is quite wrong for VMS.
  496.     $self->{DEV_NULL}   = '';
  497.  
  498.     if ($self->{OBJECT} =~ /\s/) {
  499.         $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
  500.         $self->{OBJECT} = $self->wraplist(
  501.             map $self->fixpath($_,0), split /,?\s+/, $self->{OBJECT}
  502.         );
  503.     }
  504.  
  505.     $self->{LDFROM} = $self->wraplist(
  506.         map $self->fixpath($_,0), split /,?\s+/, $self->{LDFROM}
  507.     );
  508. }
  509.  
  510.  
  511. =item init_platform (override)
  512.  
  513. Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION.
  514.  
  515. MM_VMS_REVISION is for backwards compatibility before MM_VMS had a
  516. $VERSION.
  517.  
  518. =cut
  519.  
  520. sub init_platform {
  521.     my($self) = shift;
  522.  
  523.     $self->{MM_VMS_REVISION} = $Revision;
  524.     $self->{MM_VMS_VERSION}  = $VERSION;
  525.     $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS')
  526.       if $self->{PERL_SRC};
  527. }
  528.  
  529.  
  530. =item platform_constants
  531.  
  532. =cut
  533.  
  534. sub platform_constants {
  535.     my($self) = shift;
  536.     my $make_frag = '';
  537.  
  538.     foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION))
  539.     {
  540.         next unless defined $self->{$macro};
  541.         $make_frag .= "$macro = $self->{$macro}\n";
  542.     }
  543.  
  544.     return $make_frag;
  545. }
  546.  
  547.  
  548. =item init_VERSION (override)
  549.  
  550. Override the *DEFINE_VERSION macros with VMS semantics.  Translate the
  551. MAKEMAKER filepath to VMS style.
  552.  
  553. =cut
  554.  
  555. sub init_VERSION {
  556.     my $self = shift;
  557.  
  558.     $self->SUPER::init_VERSION;
  559.  
  560.     $self->{DEFINE_VERSION}    = '"$(VERSION_MACRO)=""$(VERSION)"""';
  561.     $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""';
  562.     $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'});
  563. }
  564.  
  565.  
  566. =item constants (override)
  567.  
  568. Fixes up numerous file and directory macros to insure VMS syntax
  569. regardless of input syntax.  Also makes lists of files
  570. comma-separated.
  571.  
  572. =cut
  573.  
  574. sub constants {
  575.     my($self) = @_;
  576.  
  577.     # Be kind about case for pollution
  578.     for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
  579.  
  580.     # Cleanup paths for directories in MMS macros.
  581.     foreach my $macro ( qw [
  582.             INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB 
  583.             PERL_LIB PERL_ARCHLIB
  584.             PERL_INC PERL_SRC ],
  585.                         (map { 'INSTALL'.$_ } $self->installvars)
  586.                       ) 
  587.     {
  588.         next unless defined $self->{$macro};
  589.         next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
  590.         $self->{$macro} = $self->fixpath($self->{$macro},1);
  591.     }
  592.  
  593.     # Cleanup paths for files in MMS macros.
  594.     foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD 
  595.                            MAKE_APERL_FILE MYEXTLIB] ) 
  596.     {
  597.         next unless defined $self->{$macro};
  598.         $self->{$macro} = $self->fixpath($self->{$macro},0);
  599.     }
  600.  
  601.     # Fixup files for MMS macros
  602.     # XXX is this list complete?
  603.     for my $macro (qw/
  604.                    FULLEXT VERSION_FROM OBJECT LDFROM
  605.           /    ) {
  606.         next unless defined $self->{$macro};
  607.         $self->{$macro} = $self->fixpath($self->{$macro},0);
  608.     }
  609.  
  610.  
  611.     for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) {
  612.         # Where is the space coming from? --jhi
  613.         next unless $self ne " " && defined $self->{$macro};
  614.         my %tmp = ();
  615.         for my $key (keys %{$self->{$macro}}) {
  616.             $tmp{$self->fixpath($key,0)} = 
  617.                                      $self->fixpath($self->{$macro}{$key},0);
  618.         }
  619.         $self->{$macro} = \%tmp;
  620.     }
  621.  
  622.     for my $macro (qw/ C O_FILES H /) {
  623.         next unless defined $self->{$macro};
  624.         my @tmp = ();
  625.         for my $val (@{$self->{$macro}}) {
  626.             push(@tmp,$self->fixpath($val,0));
  627.         }
  628.         $self->{$macro} = \@tmp;
  629.     }
  630.  
  631.     # mms/k does not define a $(MAKE) macro.
  632.     $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)';
  633.  
  634.     return $self->SUPER::constants;
  635. }
  636.  
  637.  
  638. =item special_targets
  639.  
  640. Clear the default .SUFFIXES and put in our own list.
  641.  
  642. =cut
  643.  
  644. sub special_targets {
  645.     my $self = shift;
  646.  
  647.     my $make_frag .= <<'MAKE_FRAG';
  648. .SUFFIXES :
  649. .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs
  650.  
  651. MAKE_FRAG
  652.  
  653.     return $make_frag;
  654. }
  655.  
  656. =item cflags (override)
  657.  
  658. Bypass shell script and produce qualifiers for CC directly (but warn
  659. user if a shell script for this extension exists).  Fold multiple
  660. /Defines into one, since some C compilers pay attention to only one
  661. instance of this qualifier on the command line.
  662.  
  663. =cut
  664.  
  665. sub cflags {
  666.     my($self,$libperl) = @_;
  667.     my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
  668.     my($definestr,$undefstr,$flagoptstr) = ('','','');
  669.     my($incstr) = '/Include=($(PERL_INC)';
  670.     my($name,$sys,@m);
  671.  
  672.     ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
  673.     print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
  674.          " required to modify CC command for $self->{'BASEEXT'}\n"
  675.     if ($Config{$name});
  676.  
  677.     if ($quals =~ / -[DIUOg]/) {
  678.     while ($quals =~ / -([Og])(\d*)\b/) {
  679.         my($type,$lvl) = ($1,$2);
  680.         $quals =~ s/ -$type$lvl\b\s*//;
  681.         if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
  682.         else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
  683.     }
  684.     while ($quals =~ / -([DIU])(\S+)/) {
  685.         my($type,$def) = ($1,$2);
  686.         $quals =~ s/ -$type$def\s*//;
  687.         $def =~ s/"/""/g;
  688.         if    ($type eq 'D') { $definestr .= qq["$def",]; }
  689.         elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
  690.         else                 { $undefstr  .= qq["$def",]; }
  691.     }
  692.     }
  693.     if (length $quals and $quals !~ m!/!) {
  694.     warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
  695.     $quals = '';
  696.     }
  697.     $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE};
  698.     if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
  699.     if (length $undefstr)  { chop($undefstr);  $quals .= "/Undef=($undefstr)";   }
  700.     # Deal with $self->{DEFINE} here since some C compilers pay attention
  701.     # to only one /Define clause on command line, so we have to
  702.     # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
  703.     # ($self->{DEFINE} has already been VMSified in constants() above)
  704.     if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }
  705.     for my $type (qw(Def Undef)) {
  706.     my(@terms);
  707.     while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {
  708.         my $term = $1;
  709.         $term =~ s:^\((.+)\)$:$1:;
  710.         push @terms, $term;
  711.         }
  712.     if ($type eq 'Def') {
  713.         push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ];
  714.     }
  715.     if (@terms) {
  716.         $quals =~ s:/${type}i?n?e?=[^/]+::ig;
  717.         $quals .= "/${type}ine=(" . join(',',@terms) . ')';
  718.     }
  719.     }
  720.  
  721.     $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
  722.  
  723.     # Likewise with $self->{INC} and /Include
  724.     if ($self->{'INC'}) {
  725.     my(@includes) = split(/\s+/,$self->{INC});
  726.     foreach (@includes) {
  727.         s/^-I//;
  728.         $incstr .= ','.$self->fixpath($_,1);
  729.     }
  730.     }
  731.     $quals .= "$incstr)";
  732. #    $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;
  733.     $self->{CCFLAGS} = $quals;
  734.  
  735.     $self->{PERLTYPE} ||= '';
  736.  
  737.     $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
  738.     if ($self->{OPTIMIZE} !~ m!/!) {
  739.     if    ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
  740.     elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
  741.         $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
  742.     }
  743.     else {
  744.         warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
  745.         $self->{OPTIMIZE} = '/Optimize';
  746.     }
  747.     }
  748.  
  749.     return $self->{CFLAGS} = qq{
  750. CCFLAGS = $self->{CCFLAGS}
  751. OPTIMIZE = $self->{OPTIMIZE}
  752. PERLTYPE = $self->{PERLTYPE}
  753. };
  754. }
  755.  
  756. =item const_cccmd (override)
  757.  
  758. Adds directives to point C preprocessor to the right place when
  759. handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
  760. command line a bit differently than MM_Unix method.
  761.  
  762. =cut
  763.  
  764. sub const_cccmd {
  765.     my($self,$libperl) = @_;
  766.     my(@m);
  767.  
  768.     return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
  769.     return '' unless $self->needs_linking();
  770.     if ($Config{'vms_cc_type'} eq 'gcc') {
  771.         push @m,'
  772. .FIRST
  773.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
  774.     }
  775.     elsif ($Config{'vms_cc_type'} eq 'vaxc') {
  776.         push @m,'
  777. .FIRST
  778.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
  779.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
  780.     }
  781.     else {
  782.         push @m,'
  783. .FIRST
  784.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
  785.         ($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
  786.     ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
  787.     }
  788.  
  789.     push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
  790.  
  791.     $self->{CONST_CCCMD} = join('',@m);
  792. }
  793.  
  794.  
  795. =item tools_other (override)
  796.  
  797. Throw in some dubious extra macros for Makefile args.
  798.  
  799. Also keep around the old $(SAY) macro in case somebody's using it.
  800.  
  801. =cut
  802.  
  803. sub tools_other {
  804.     my($self) = @_;
  805.  
  806.     # XXX Are these necessary?  Does anyone override them?  They're longer
  807.     # than just typing the literal string.
  808.     my $extra_tools = <<'EXTRA_TOOLS';
  809.  
  810. # Just in case anyone is using the old macro.
  811. USEMACROS = $(MACROSTART)
  812. SAY = $(ECHO)
  813.  
  814. EXTRA_TOOLS
  815.  
  816.     return $self->SUPER::tools_other . $extra_tools;
  817. }
  818.  
  819. =item init_dist (override)
  820.  
  821. VMSish defaults for some values.
  822.  
  823.   macro         description                     default
  824.  
  825.   ZIPFLAGS      flags to pass to ZIP            -Vu
  826.  
  827.   COMPRESS      compression command to          gzip
  828.                 use for tarfiles
  829.   SUFFIX        suffix to put on                -gz 
  830.                 compressed files
  831.  
  832.   SHAR          shar command to use             vms_share
  833.  
  834.   DIST_DEFAULT  default target to use to        tardist
  835.                 create a distribution
  836.  
  837.   DISTVNAME     Use VERSION_SYM instead of      $(DISTNAME)-$(VERSION_SYM)
  838.                 VERSION for the name
  839.  
  840. =cut
  841.  
  842. sub init_dist {
  843.     my($self) = @_;
  844.     $self->{ZIPFLAGS}     ||= '-Vu';
  845.     $self->{COMPRESS}     ||= 'gzip';
  846.     $self->{SUFFIX}       ||= '-gz';
  847.     $self->{SHAR}         ||= 'vms_share';
  848.     $self->{DIST_DEFAULT} ||= 'zipdist';
  849.  
  850.     $self->SUPER::init_dist;
  851.  
  852.     $self->{DISTVNAME}    = "$self->{DISTNAME}-$self->{VERSION_SYM}";
  853. }
  854.  
  855. =item c_o (override)
  856.  
  857. Use VMS syntax on command line.  In particular, $(DEFINE) and
  858. $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
  859.  
  860. =cut
  861.  
  862. sub c_o {
  863.     my($self) = @_;
  864.     return '' unless $self->needs_linking();
  865.     '
  866. .c$(OBJ_EXT) :
  867.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  868.  
  869. .cpp$(OBJ_EXT) :
  870.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
  871.  
  872. .cxx$(OBJ_EXT) :
  873.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
  874.  
  875. ';
  876. }
  877.  
  878. =item xs_c (override)
  879.  
  880. Use MM[SK] macros.
  881.  
  882. =cut
  883.  
  884. sub xs_c {
  885.     my($self) = @_;
  886.     return '' unless $self->needs_linking();
  887.     '
  888. .xs.c :
  889.     $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
  890. ';
  891. }
  892.  
  893. =item xs_o (override)
  894.  
  895. Use MM[SK] macros, and VMS command line for C compiler.
  896.  
  897. =cut
  898.  
  899. sub xs_o {    # many makes are too dumb to use xs_c then c_o
  900.     my($self) = @_;
  901.     return '' unless $self->needs_linking();
  902.     '
  903. .xs$(OBJ_EXT) :
  904.     $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
  905.     $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  906. ';
  907. }
  908.  
  909.  
  910. =item dlsyms (override)
  911.  
  912. Create VMS linker options files specifying universal symbols for this
  913. extension's shareable image, and listing other shareable images or 
  914. libraries to which it should be linked.
  915.  
  916. =cut
  917.  
  918. sub dlsyms {
  919.     my($self,%attribs) = @_;
  920.  
  921.     return '' unless $self->needs_linking();
  922.  
  923.     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
  924.     my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
  925.     my($funclist)  = $attribs{FUNCLIST}  || $self->{FUNCLIST}  || [];
  926.     my(@m);
  927.  
  928.     unless ($self->{SKIPHASH}{'dynamic'}) {
  929.     push(@m,'
  930. dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  931.     $(NOECHO) $(NOOP)
  932. ');
  933.     }
  934.  
  935.     push(@m,'
  936. static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  937.     $(NOECHO) $(NOOP)
  938. ') unless $self->{SKIPHASH}{'static'};
  939.  
  940.     push @m,'
  941. $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
  942.     $(CP) $(MMS$SOURCE) $(MMS$TARGET)
  943.  
  944. $(BASEEXT).opt : Makefile.PL
  945.     $(PERLRUN) -e "use ExtUtils::Mksymlists;" -
  946.     ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
  947.     neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
  948.     q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];
  949.  
  950.     push @m, '    $(PERL) -e "print ""$(INST_STATIC)/Include=';
  951.     if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
  952.         $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { 
  953.         push @m, ($Config{d_vms_case_sensitive_symbols}
  954.                ? uc($self->{BASEEXT}) :'$(BASEEXT)');
  955.     }
  956.     else {  # We don't have a "main" object file, so pull 'em all in
  957.        # Upcase module names if linker is being case-sensitive
  958.        my($upcase) = $Config{d_vms_case_sensitive_symbols};
  959.     my(@omods) = map { s/\.[^.]*$//;         # Trim off file type
  960.                        s[\$\(\w+_EXT\)][];   # even as a macro
  961.                        s/.*[:>\/\]]//;       # Trim off dir spec
  962.                $upcase ? uc($_) : $_;
  963.                      } split ' ', $self->eliminate_macros($self->{OBJECT});
  964.         my($tmp,@lines,$elt) = '';
  965.     $tmp = shift @omods;
  966.     foreach $elt (@omods) {
  967.         $tmp .= ",$elt";
  968.         if (length($tmp) > 80) { push @lines, $tmp;  $tmp = ''; }
  969.     }
  970.     push @lines, $tmp;
  971.     push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';
  972.     }
  973.     push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";
  974.  
  975.     if (length $self->{LDLOADLIBS}) {
  976.     my($lib); my($line) = '';
  977.     foreach $lib (split ' ', $self->{LDLOADLIBS}) {
  978.         $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
  979.         if (length($line) + length($lib) > 160) {
  980.         push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
  981.         $line = $lib . '\n';
  982.         }
  983.         else { $line .= $lib . '\n'; }
  984.     }
  985.     push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
  986.     }
  987.  
  988.     join('',@m);
  989.  
  990. }
  991.  
  992. =item dynamic_lib (override)
  993.  
  994. Use VMS Link command.
  995.  
  996. =cut
  997.  
  998. sub dynamic_lib {
  999.     my($self, %attribs) = @_;
  1000.     return '' unless $self->needs_linking(); #might be because of a subdir
  1001.  
  1002.     return '' unless $self->has_link_code();
  1003.  
  1004.     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
  1005.     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
  1006.     my $shr = $Config{'dbgprefix'} . 'PerlShr';
  1007.     my(@m);
  1008.     push @m,"
  1009.  
  1010. OTHERLDFLAGS = $otherldflags
  1011. INST_DYNAMIC_DEP = $inst_dynamic_dep
  1012.  
  1013. ";
  1014.     push @m, '
  1015. $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  1016.     If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
  1017.     Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
  1018. ';
  1019.  
  1020.     join('',@m);
  1021. }
  1022.  
  1023.  
  1024. =item static_lib (override)
  1025.  
  1026. Use VMS commands to manipulate object library.
  1027.  
  1028. =cut
  1029.  
  1030. sub static_lib {
  1031.     my($self) = @_;
  1032.     return '' unless $self->needs_linking();
  1033.  
  1034.     return '
  1035. $(INST_STATIC) :
  1036.     $(NOECHO) $(NOOP)
  1037. ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
  1038.  
  1039.     my(@m,$lib);
  1040.     push @m,'
  1041. # Rely on suffix rule for update action
  1042. $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists
  1043.  
  1044. $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
  1045. ';
  1046.     # If this extension has its own library (eg SDBM_File)
  1047.     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
  1048.     push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
  1049.  
  1050.     push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
  1051.  
  1052.     # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
  1053.     # 'cause it's a library and you can't stick them in other libraries.
  1054.     # In that case, we use $OBJECT instead and hope for the best
  1055.     if ($self->{MYEXTLIB}) {
  1056.       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
  1057.     } else {
  1058.       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
  1059.     }
  1060.     
  1061.     push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
  1062.     foreach $lib (split ' ', $self->{EXTRALIBS}) {
  1063.       push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
  1064.     }
  1065.     join('',@m);
  1066. }
  1067.  
  1068.  
  1069. =item extra_clean_files
  1070.  
  1071. Clean up some OS specific files.  Plus the temp file used to shorten
  1072. a lot of commands.
  1073.  
  1074. =cut
  1075.  
  1076. sub extra_clean_files {
  1077.     return qw(
  1078.               *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
  1079.               .MM_Tmp
  1080.              );
  1081. }
  1082.  
  1083.  
  1084. =item zipfile_target
  1085.  
  1086. =item tarfile_target
  1087.  
  1088. =item shdist_target
  1089.  
  1090. Syntax for invoking shar, tar and zip differs from that for Unix.
  1091.  
  1092. =cut
  1093.  
  1094. sub zipfile_target {
  1095.     my($self) = shift;
  1096.  
  1097.     return <<'MAKE_FRAG';
  1098. $(DISTVNAME).zip : distdir
  1099.     $(PREOP)
  1100.     $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
  1101.     $(RM_RF) $(DISTVNAME)
  1102.     $(POSTOP)
  1103. MAKE_FRAG
  1104. }
  1105.  
  1106. sub tarfile_target {
  1107.     my($self) = shift;
  1108.  
  1109.     return <<'MAKE_FRAG';
  1110. $(DISTVNAME).tar$(SUFFIX) : distdir
  1111.     $(PREOP)
  1112.     $(TO_UNIX)
  1113.         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
  1114.     $(RM_RF) $(DISTVNAME)
  1115.     $(COMPRESS) $(DISTVNAME).tar
  1116.     $(POSTOP)
  1117. MAKE_FRAG
  1118. }
  1119.  
  1120. sub shdist_target {
  1121.     my($self) = shift;
  1122.  
  1123.     return <<'MAKE_FRAG';
  1124. shdist : distdir
  1125.     $(PREOP)
  1126.     $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
  1127.     $(RM_RF) $(DISTVNAME)
  1128.     $(POSTOP)
  1129. MAKE_FRAG
  1130. }
  1131.  
  1132.  
  1133. # --- Test and Installation Sections ---
  1134.  
  1135. =item install (override)
  1136.  
  1137. Work around DCL's 255 character limit several times,and use
  1138. VMS-style command line quoting in a few cases.
  1139.  
  1140. =cut
  1141.  
  1142. sub install {
  1143.     my($self, %attribs) = @_;
  1144.     my(@m);
  1145.  
  1146.     push @m, q[
  1147. install :: all pure_install doc_install
  1148.     $(NOECHO) $(NOOP)
  1149.  
  1150. install_perl :: all pure_perl_install doc_perl_install
  1151.     $(NOECHO) $(NOOP)
  1152.  
  1153. install_site :: all pure_site_install doc_site_install
  1154.     $(NOECHO) $(NOOP)
  1155.  
  1156. pure_install :: pure_$(INSTALLDIRS)_install
  1157.     $(NOECHO) $(NOOP)
  1158.  
  1159. doc_install :: doc_$(INSTALLDIRS)_install
  1160.         $(NOECHO) $(NOOP)
  1161.  
  1162. pure__install : pure_site_install
  1163.     $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  1164.  
  1165. doc__install : doc_site_install
  1166.     $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  1167.  
  1168. # This hack brought to you by DCL's 255-character command line limit
  1169. pure_perl_install ::
  1170.     $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
  1171.     $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
  1172.     $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp
  1173.     $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp
  1174.     $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp
  1175.     $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
  1176.     $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp
  1177.     $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) " >>.MM_tmp
  1178.     $(NOECHO) $(MOD_INSTALL) <.MM_tmp
  1179.     $(NOECHO) $(RM_F) .MM_tmp
  1180.     $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
  1181.  
  1182. # Likewise
  1183. pure_site_install ::
  1184.     $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
  1185.     $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
  1186.     $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp
  1187.     $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp
  1188.     $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp
  1189.     $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
  1190.     $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) " >>.MM_tmp
  1191.     $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) " >>.MM_tmp
  1192.     $(NOECHO) $(MOD_INSTALL) <.MM_tmp
  1193.     $(NOECHO) $(RM_F) .MM_tmp
  1194.     $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
  1195.  
  1196. pure_vendor_install ::
  1197.     $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
  1198.     $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
  1199.     $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp
  1200.     $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp
  1201.     $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp
  1202.     $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
  1203.     $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) " >>.MM_tmp
  1204.     $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) " >>.MM_tmp
  1205.     $(NOECHO) $(MOD_INSTALL) <.MM_tmp
  1206.     $(NOECHO) $(RM_F) .MM_tmp
  1207.  
  1208. # Ditto
  1209. doc_perl_install ::
  1210.     $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
  1211.     $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  1212.     $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp
  1213.     $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
  1214.     $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
  1215.     $(NOECHO) $(RM_F) .MM_tmp
  1216.  
  1217. # And again
  1218. doc_site_install ::
  1219.     $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
  1220.     $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  1221.     $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp
  1222.     $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
  1223.     $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
  1224.     $(NOECHO) $(RM_F) .MM_tmp
  1225.  
  1226. doc_vendor_install ::
  1227.     $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
  1228.     $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  1229.     $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp
  1230.     $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
  1231.     $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
  1232.     $(NOECHO) $(RM_F) .MM_tmp
  1233.  
  1234. ];
  1235.  
  1236.     push @m, q[
  1237. uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  1238.     $(NOECHO) $(NOOP)
  1239.  
  1240. uninstall_from_perldirs ::
  1241.     $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
  1242.     $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
  1243.     $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
  1244.     $(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
  1245.  
  1246. uninstall_from_sitedirs ::
  1247.     $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
  1248.     $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
  1249.     $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
  1250.     $(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
  1251. ];
  1252.  
  1253.     join('',@m);
  1254. }
  1255.  
  1256. =item perldepend (override)
  1257.  
  1258. Use VMS-style syntax for files; it's cheaper to just do it directly here
  1259. than to have the MM_Unix method call C<catfile> repeatedly.  Also, if
  1260. we have to rebuild Config.pm, use MM[SK] to do it.
  1261.  
  1262. =cut
  1263.  
  1264. sub perldepend {
  1265.     my($self) = @_;
  1266.     my(@m);
  1267.  
  1268.     push @m, '
  1269. $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
  1270. $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h
  1271. $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
  1272. $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h
  1273. $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
  1274. $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
  1275. $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
  1276. $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
  1277. $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h
  1278. $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h
  1279. $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
  1280. $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
  1281. $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
  1282. $(OBJECT) : $(PERL_INC)thread.h, $(PERL_INC)util.h, $(PERL_INC)vmsish.h
  1283.  
  1284. ' if $self->{OBJECT}; 
  1285.  
  1286.     if ($self->{PERL_SRC}) {
  1287.     my(@macros);
  1288.     my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
  1289.     push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
  1290.     push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
  1291.     push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
  1292.     push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
  1293.     push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
  1294.     $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
  1295.     push(@m,q[
  1296. # Check for unpropagated config.sh changes. Should never happen.
  1297. # We do NOT just update config.h because that is not sufficient.
  1298. # An out of date config.h is not fatal but complains loudly!
  1299. $(PERL_INC)config.h : $(PERL_SRC)config.sh
  1300.     $(NOOP)
  1301.  
  1302. $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
  1303.     $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
  1304.     olddef = F$Environment("Default")
  1305.     Set Default $(PERL_SRC)
  1306.     $(MMS)],$mmsquals,);
  1307.     if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
  1308.         my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
  1309.         $target =~ s/\Q$prefix/[/;
  1310.         push(@m," $target");
  1311.     }
  1312.     else { push(@m,' $(MMS$TARGET)'); }
  1313.     push(@m,q[
  1314.     Set Default 'olddef'
  1315. ]);
  1316.     }
  1317.  
  1318.     push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
  1319.       if %{$self->{XS}};
  1320.  
  1321.     join('',@m);
  1322. }
  1323.  
  1324.  
  1325. =item makeaperl (override)
  1326.  
  1327. Undertake to build a new set of Perl images using VMS commands.  Since
  1328. VMS does dynamic loading, it's not necessary to statically link each
  1329. extension into the Perl image, so this isn't the normal build path.
  1330. Consequently, it hasn't really been tested, and may well be incomplete.
  1331.  
  1332. =cut
  1333.  
  1334. use vars qw(%olbs);
  1335.  
  1336. sub makeaperl {
  1337.     my($self, %attribs) = @_;
  1338.     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = 
  1339.       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
  1340.     my(@m);
  1341.     push @m, "
  1342. # --- MakeMaker makeaperl section ---
  1343. MAP_TARGET    = $target
  1344. ";
  1345.     return join '', @m if $self->{PARENT};
  1346.  
  1347.     my($dir) = join ":", @{$self->{DIR}};
  1348.  
  1349.     unless ($self->{MAKEAPERL}) {
  1350.     push @m, q{
  1351. $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  1352.     $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
  1353.     $(NOECHO) $(PERLRUNINST) \
  1354.         Makefile.PL DIR=}, $dir, q{ \
  1355.         FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
  1356.         MAKEAPERL=1 NORECURS=1 };
  1357.  
  1358.     push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
  1359.  
  1360. $(MAP_TARGET) :: $(MAKE_APERL_FILE)
  1361.     $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
  1362. };
  1363.     push @m, "\n";
  1364.  
  1365.     return join '', @m;
  1366.     }
  1367.  
  1368.  
  1369.     my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
  1370.     local($_);
  1371.  
  1372.     # The front matter of the linkcommand...
  1373.     $linkcmd = join ' ', $Config{'ld'},
  1374.         grep($_, @Config{qw(large split ldflags ccdlflags)});
  1375.     $linkcmd =~ s/\s+/ /g;
  1376.  
  1377.     # Which *.olb files could we make use of...
  1378.     local(%olbs);       # XXX can this be lexical?
  1379.     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
  1380.     require File::Find;
  1381.     File::Find::find(sub {
  1382.     return unless m/\Q$self->{LIB_EXT}\E$/;
  1383.     return if m/^libperl/;
  1384.  
  1385.     if( exists $self->{INCLUDE_EXT} ){
  1386.         my $found = 0;
  1387.         my $incl;
  1388.         my $xx;
  1389.  
  1390.         ($xx = $File::Find::name) =~ s,.*?/auto/,,;
  1391.         $xx =~ s,/?$_,,;
  1392.         $xx =~ s,/,::,g;
  1393.  
  1394.         # Throw away anything not explicitly marked for inclusion.
  1395.         # DynaLoader is implied.
  1396.         foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
  1397.             if( $xx eq $incl ){
  1398.                 $found++;
  1399.                 last;
  1400.             }
  1401.         }
  1402.         return unless $found;
  1403.     }
  1404.     elsif( exists $self->{EXCLUDE_EXT} ){
  1405.         my $excl;
  1406.         my $xx;
  1407.  
  1408.         ($xx = $File::Find::name) =~ s,.*?/auto/,,;
  1409.         $xx =~ s,/?$_,,;
  1410.         $xx =~ s,/,::,g;
  1411.  
  1412.         # Throw away anything explicitly marked for exclusion
  1413.         foreach $excl (@{$self->{EXCLUDE_EXT}}){
  1414.             return if( $xx eq $excl );
  1415.         }
  1416.     }
  1417.  
  1418.     $olbs{$ENV{DEFAULT}} = $_;
  1419.     }, grep( -d $_, @{$searchdirs || []}));
  1420.  
  1421.     # We trust that what has been handed in as argument will be buildable
  1422.     $static = [] unless $static;
  1423.     @olbs{@{$static}} = (1) x @{$static};
  1424.  
  1425.     $extra = [] unless $extra && ref $extra eq 'ARRAY';
  1426.     # Sort the object libraries in inverse order of
  1427.     # filespec length to try to insure that dependent extensions
  1428.     # will appear before their parents, so the linker will
  1429.     # search the parent library to resolve references.
  1430.     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
  1431.     # references from [.intuit.dwim]dwim.obj can be found
  1432.     # in [.intuit]intuit.olb).
  1433.     for (sort { length($a) <=> length($b) } keys %olbs) {
  1434.     next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
  1435.     my($dir) = $self->fixpath($_,1);
  1436.     my($extralibs) = $dir . "extralibs.ld";
  1437.     my($extopt) = $dir . $olbs{$_};
  1438.     $extopt =~ s/$self->{LIB_EXT}$/.opt/;
  1439.     push @optlibs, "$dir$olbs{$_}";
  1440.     # Get external libraries this extension will need
  1441.     if (-f $extralibs ) {
  1442.         my %seenthis;
  1443.         open LIST,$extralibs or warn $!,next;
  1444.         while (<LIST>) {
  1445.         chomp;
  1446.         # Include a library in the link only once, unless it's mentioned
  1447.         # multiple times within a single extension's options file, in which
  1448.         # case we assume the builder needed to search it again later in the
  1449.         # link.
  1450.         my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
  1451.         $libseen{$_}++;  $seenthis{$_}++;
  1452.         next if $skip;
  1453.         push @$extra,$_;
  1454.         }
  1455.         close LIST;
  1456.     }
  1457.     # Get full name of extension for ExtUtils::Miniperl
  1458.     if (-f $extopt) {
  1459.         open OPT,$extopt or die $!;
  1460.         while (<OPT>) {
  1461.         next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
  1462.         my $pkg = $1;
  1463.         $pkg =~ s#__*#::#g;
  1464.         push @staticpkgs,$pkg;
  1465.         }
  1466.     }
  1467.     }
  1468.     # Place all of the external libraries after all of the Perl extension
  1469.     # libraries in the final link, in order to maximize the opportunity
  1470.     # for XS code from multiple extensions to resolve symbols against the
  1471.     # same external library while only including that library once.
  1472.     push @optlibs, @$extra;
  1473.  
  1474.     $target = "Perl$Config{'exe_ext'}" unless $target;
  1475.     my $shrtarget;
  1476.     ($shrtarget,$targdir) = fileparse($target);
  1477.     $shrtarget =~ s/^([^.]*)/$1Shr/;
  1478.     $shrtarget = $targdir . $shrtarget;
  1479.     $target = "Perlshr.$Config{'dlext'}" unless $target;
  1480.     $tmpdir = "[]" unless $tmpdir;
  1481.     $tmpdir = $self->fixpath($tmpdir,1);
  1482.     if (@optlibs) { $extralist = join(' ',@optlibs); }
  1483.     else          { $extralist = ''; }
  1484.     # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
  1485.     # that's what we're building here).
  1486.     push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
  1487.     if ($libperl) {
  1488.     unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
  1489.         print STDOUT "Warning: $libperl not found\n";
  1490.         undef $libperl;
  1491.     }
  1492.     }
  1493.     unless ($libperl) {
  1494.     if (defined $self->{PERL_SRC}) {
  1495.         $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
  1496.     } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
  1497.     } else {
  1498.         print STDOUT "Warning: $libperl not found
  1499.     If you're going to build a static perl binary, make sure perl is installed
  1500.     otherwise ignore this warning\n";
  1501.     }
  1502.     }
  1503.     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
  1504.  
  1505.     push @m, '
  1506. # Fill in the target you want to produce if it\'s not perl
  1507. MAP_TARGET    = ',$self->fixpath($target,0),'
  1508. MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
  1509. MAP_LINKCMD   = $linkcmd
  1510. MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
  1511. MAP_EXTRA     = $extralist
  1512. MAP_LIBPERL = ",$self->fixpath($libperl,0),'
  1513. ';
  1514.  
  1515.  
  1516.     push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
  1517.     foreach (@optlibs) {
  1518.     push @m,'    $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
  1519.     }
  1520.     push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
  1521.     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
  1522.  
  1523.     push @m,'
  1524. $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
  1525.     $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
  1526. $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
  1527.     $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
  1528.     $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
  1529.     $(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
  1530.     $(NOECHO) $(ECHO) "To remove the intermediate files, say
  1531.     $(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
  1532. ';
  1533.     push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
  1534.     push @m, "# More from the 255-char line length limit\n";
  1535.     foreach (@staticpkgs) {
  1536.     push @m,'    $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
  1537.     }
  1538.  
  1539.     push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
  1540.     $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
  1541.     $(NOECHO) $(RM_F) %sWritemain.tmp
  1542. MAKE_FRAG
  1543.  
  1544.     push @m, q[
  1545. # Still more from the 255-char line length limit
  1546. doc_inst_perl :
  1547.     $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  1548.     $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
  1549.     $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
  1550.     $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
  1551.     $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
  1552.     $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
  1553.     $(NOECHO) $(RM_F) .MM_tmp
  1554. ];
  1555.  
  1556.     push @m, "
  1557. inst_perl : pure_inst_perl doc_inst_perl
  1558.     \$(NOECHO) \$(NOOP)
  1559.  
  1560. pure_inst_perl : \$(MAP_TARGET)
  1561.     $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
  1562.     $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
  1563.  
  1564. clean :: map_clean
  1565.     \$(NOECHO) \$(NOOP)
  1566.  
  1567. map_clean :
  1568.     \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
  1569.     \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
  1570. ";
  1571.  
  1572.     join '', @m;
  1573. }
  1574.  
  1575. # --- Output postprocessing section ---
  1576.  
  1577. =item maketext_filter (override)
  1578.  
  1579. Insure that colons marking targets are preceded by space, in order
  1580. to distinguish the target delimiter from a colon appearing as
  1581. part of a filespec.
  1582.  
  1583. =cut
  1584.  
  1585. sub maketext_filter {
  1586.     my($self, $text) = @_;
  1587.  
  1588.     $text =~ s/^([^\s:=]+)(:+\s)/$1 $2/mg;
  1589.     return $text;
  1590. }
  1591.  
  1592. =item prefixify (override)
  1593.  
  1594. prefixifying on VMS is simple.  Each should simply be:
  1595.  
  1596.     perl_root:[some.dir]
  1597.  
  1598. which can just be converted to:
  1599.  
  1600.     volume:[your.prefix.some.dir]
  1601.  
  1602. otherwise you get the default layout.
  1603.  
  1604. In effect, your search prefix is ignored and $Config{vms_prefix} is
  1605. used instead.
  1606.  
  1607. =cut
  1608.  
  1609. sub prefixify {
  1610.     my($self, $var, $sprefix, $rprefix, $default) = @_;
  1611.  
  1612.     # Translate $(PERLPREFIX) to a real path.
  1613.     $rprefix = $self->eliminate_macros($rprefix);
  1614.     $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
  1615.     $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
  1616.  
  1617.     $default = VMS::Filespec::vmsify($default) 
  1618.       unless $default =~ /\[.*\]/;
  1619.  
  1620.     (my $var_no_install = $var) =~ s/^install//;
  1621.     my $path = $self->{uc $var} || 
  1622.                $ExtUtils::MM_Unix::Config_Override{lc $var} || 
  1623.                $Config{lc $var} || $Config{lc $var_no_install};
  1624.  
  1625.     if( !$path ) {
  1626.         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
  1627.         $path = $self->_prefixify_default($rprefix, $default);
  1628.     }
  1629.     elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
  1630.         # do nothing if there's no prefix or if its relative
  1631.     }
  1632.     elsif( $sprefix eq $rprefix ) {
  1633.         print STDERR "  no new prefix.\n" if $Verbose >= 2;
  1634.     }
  1635.     else {
  1636.  
  1637.         print STDERR "  prefixify $var => $path\n"     if $Verbose >= 2;
  1638.         print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
  1639.  
  1640.         my($path_vol, $path_dirs) = $self->splitpath( $path );
  1641.         if( $path_vol eq $Config{vms_prefix}.':' ) {
  1642.             print STDERR "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
  1643.  
  1644.             $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
  1645.             $path = $self->_catprefix($rprefix, $path_dirs);
  1646.         }
  1647.         else {
  1648.             $path = $self->_prefixify_default($rprefix, $default);
  1649.         }
  1650.     }
  1651.  
  1652.     print "    now $path\n" if $Verbose >= 2;
  1653.     return $self->{uc $var} = $path;
  1654. }
  1655.  
  1656.  
  1657. sub _prefixify_default {
  1658.     my($self, $rprefix, $default) = @_;
  1659.  
  1660.     print STDERR "  cannot prefix, using default.\n" if $Verbose >= 2;
  1661.  
  1662.     if( !$default ) {
  1663.         print STDERR "No default!\n" if $Verbose >= 1;
  1664.         return;
  1665.     }
  1666.     if( !$rprefix ) {
  1667.         print STDERR "No replacement prefix!\n" if $Verbose >= 1;
  1668.         return '';
  1669.     }
  1670.  
  1671.     return $self->_catprefix($rprefix, $default);
  1672. }
  1673.  
  1674. sub _catprefix {
  1675.     my($self, $rprefix, $default) = @_;
  1676.  
  1677.     my($rvol, $rdirs) = $self->splitpath($rprefix);
  1678.     if( $rvol ) {
  1679.         return $self->catpath($rvol,
  1680.                                    $self->catdir($rdirs, $default),
  1681.                                    ''
  1682.                                   )
  1683.     }
  1684.     else {
  1685.         return $self->catdir($rdirs, $default);
  1686.     }
  1687. }
  1688.  
  1689.  
  1690. =item cd
  1691.  
  1692. =cut
  1693.  
  1694. sub cd {
  1695.     my($self, $dir, @cmds) = @_;
  1696.  
  1697.     $dir = vmspath($dir);
  1698.  
  1699.     my $cmd = join "\n\t", map "$_", @cmds;
  1700.  
  1701.     # No leading tab makes it look right when embedded
  1702.     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
  1703. startdir = F$Environment("Default")
  1704.     Set Default %s
  1705.     %s
  1706.     Set Default 'startdir'
  1707. MAKE_FRAG
  1708.  
  1709.     # No trailing newline makes this easier to embed
  1710.     chomp $make_frag;
  1711.  
  1712.     return $make_frag;
  1713. }
  1714.  
  1715.  
  1716. =item oneliner
  1717.  
  1718. =cut
  1719.  
  1720. sub oneliner {
  1721.     my($self, $cmd, $switches) = @_;
  1722.     $switches = [] unless defined $switches;
  1723.  
  1724.     # Strip leading and trailing newlines
  1725.     $cmd =~ s{^\n+}{};
  1726.     $cmd =~ s{\n+$}{};
  1727.  
  1728.     $cmd = $self->quote_literal($cmd);
  1729.     $cmd = $self->escape_newlines($cmd);
  1730.  
  1731.     # Switches must be quoted else they will be lowercased.
  1732.     $switches = join ' ', map { qq{"$_"} } @$switches;
  1733.  
  1734.     return qq{\$(ABSPERLRUN) $switches -e $cmd "--"};
  1735. }
  1736.  
  1737.  
  1738. =item B<echo>
  1739.  
  1740. perl trips up on "<foo>" thinking it's an input redirect.  So we use the
  1741. native Write command instead.  Besides, its faster.
  1742.  
  1743. =cut
  1744.  
  1745. sub echo {
  1746.     my($self, $text, $file, $appending) = @_;
  1747.     $appending ||= 0;
  1748.  
  1749.     my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
  1750.  
  1751.     my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
  1752.     push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) } 
  1753.                 split /\n/, $text;
  1754.     push @cmds, '$(NOECHO) Close MMECHOFILE';
  1755.     return @cmds;
  1756. }
  1757.  
  1758.  
  1759. =item quote_literal
  1760.  
  1761. =cut
  1762.  
  1763. sub quote_literal {
  1764.     my($self, $text) = @_;
  1765.  
  1766.     # I believe this is all we should need.
  1767.     $text =~ s{"}{""}g;
  1768.  
  1769.     return qq{"$text"};
  1770. }
  1771.  
  1772. =item escape_newlines
  1773.  
  1774. =cut
  1775.  
  1776. sub escape_newlines {
  1777.     my($self, $text) = @_;
  1778.  
  1779.     $text =~ s{\n}{-\n}g;
  1780.  
  1781.     return $text;
  1782. }
  1783.  
  1784. =item max_exec_len
  1785.  
  1786. 256 characters.
  1787.  
  1788. =cut
  1789.  
  1790. sub max_exec_len {
  1791.     my $self = shift;
  1792.  
  1793.     return $self->{_MAX_EXEC_LEN} ||= 256;
  1794. }
  1795.  
  1796. =item init_linker
  1797.  
  1798. =cut
  1799.  
  1800. sub init_linker {
  1801.     my $self = shift;
  1802.     $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
  1803.  
  1804.     my $shr = $Config{dbgprefix} . 'PERLSHR';
  1805.     if ($self->{PERL_SRC}) {
  1806.         $self->{PERL_ARCHIVE} ||=
  1807.           $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
  1808.     }
  1809.     else {
  1810.         $self->{PERL_ARCHIVE} ||=
  1811.           $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
  1812.     }
  1813.  
  1814.     $self->{PERL_ARCHIVE_AFTER} ||= '';
  1815. }
  1816.  
  1817. =item eliminate_macros
  1818.  
  1819. Expands MM[KS]/Make macros in a text string, using the contents of
  1820. identically named elements of C<%$self>, and returns the result
  1821. as a file specification in Unix syntax.
  1822.  
  1823. NOTE:  This is the canonical version of the method.  The version in
  1824. File::Spec::VMS is deprecated.
  1825.  
  1826. =cut
  1827.  
  1828. sub eliminate_macros {
  1829.     my($self,$path) = @_;
  1830.     return '' unless $path;
  1831.     $self = {} unless ref $self;
  1832.  
  1833.     if ($path =~ /\s/) {
  1834.       return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
  1835.     }
  1836.  
  1837.     my($npath) = unixify($path);
  1838.     # sometimes unixify will return a string with an off-by-one trailing null
  1839.     $npath =~ s{\0$}{};
  1840.  
  1841.     my($complex) = 0;
  1842.     my($head,$macro,$tail);
  1843.  
  1844.     # perform m##g in scalar context so it acts as an iterator
  1845.     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
  1846.         if (defined $self->{$2}) {
  1847.             ($head,$macro,$tail) = ($1,$2,$3);
  1848.             if (ref $self->{$macro}) {
  1849.                 if (ref $self->{$macro} eq 'ARRAY') {
  1850.                     $macro = join ' ', @{$self->{$macro}};
  1851.                 }
  1852.                 else {
  1853.                     print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
  1854.                           "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
  1855.                     $macro = "\cB$macro\cB";
  1856.                     $complex = 1;
  1857.                 }
  1858.             }
  1859.             else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
  1860.             $npath = "$head$macro$tail";
  1861.         }
  1862.     }
  1863.     if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
  1864.     $npath;
  1865. }
  1866.  
  1867. =item fixpath
  1868.  
  1869.    my $path = $mm->fixpath($path);
  1870.    my $path = $mm->fixpath($path, $is_dir);
  1871.  
  1872. Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
  1873. in any directory specification, in order to avoid juxtaposing two
  1874. VMS-syntax directories when MM[SK] is run.  Also expands expressions which
  1875. are all macro, so that we can tell how long the expansion is, and avoid
  1876. overrunning DCL's command buffer when MM[KS] is running.
  1877.  
  1878. fixpath() checks to see whether the result matches the name of a
  1879. directory in the current default directory and returns a directory or
  1880. file specification accordingly.  C<$is_dir> can be set to true to
  1881. force fixpath() to consider the path to be a directory or false to force
  1882. it to be a file.
  1883.  
  1884. NOTE:  This is the canonical version of the method.  The version in
  1885. File::Spec::VMS is deprecated.
  1886.  
  1887. =cut
  1888.  
  1889. sub fixpath {
  1890.     my($self,$path,$force_path) = @_;
  1891.     return '' unless $path;
  1892.     $self = bless {} unless ref $self;
  1893.     my($fixedpath,$prefix,$name);
  1894.  
  1895.     if ($path =~ /[ \t]/) {
  1896.       return join ' ',
  1897.              map { $self->fixpath($_,$force_path) }
  1898.          split /[ \t]+/, $path;
  1899.     }
  1900.  
  1901.     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
  1902.         if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
  1903.             $fixedpath = vmspath($self->eliminate_macros($path));
  1904.         }
  1905.         else {
  1906.             $fixedpath = vmsify($self->eliminate_macros($path));
  1907.         }
  1908.     }
  1909.     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
  1910.         my($vmspre) = $self->eliminate_macros("\$($prefix)");
  1911.         # is it a dir or just a name?
  1912.         $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
  1913.         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
  1914.         $fixedpath = vmspath($fixedpath) if $force_path;
  1915.     }
  1916.     else {
  1917.         $fixedpath = $path;
  1918.         $fixedpath = vmspath($fixedpath) if $force_path;
  1919.     }
  1920.     # No hints, so we try to guess
  1921.     if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
  1922.         $fixedpath = vmspath($fixedpath) if -d $fixedpath;
  1923.     }
  1924.  
  1925.     # Trim off root dirname if it's had other dirs inserted in front of it.
  1926.     $fixedpath =~ s/\.000000([\]>])/$1/;
  1927.     # Special case for VMS absolute directory specs: these will have had device
  1928.     # prepended during trip through Unix syntax in eliminate_macros(), since
  1929.     # Unix syntax has no way to express "absolute from the top of this device's
  1930.     # directory tree".
  1931.     if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
  1932.  
  1933.     return $fixedpath;
  1934. }
  1935.  
  1936.  
  1937. =item os_flavor
  1938.  
  1939. VMS is VMS.
  1940.  
  1941. =cut
  1942.  
  1943. sub os_flavor {
  1944.     return('VMS');
  1945. }
  1946.  
  1947. =back
  1948.  
  1949.  
  1950. =head1 AUTHOR
  1951.  
  1952. Original author Charles Bailey F<bailey@newman.upenn.edu>
  1953.  
  1954. Maintained by Michael G Schwern F<schwern@pobox.com>
  1955.  
  1956. See L<ExtUtils::MakeMaker> for patching and contact information.
  1957.  
  1958.  
  1959. =cut
  1960.  
  1961. 1;
  1962.  
  1963.